PC Answers 1995 May/PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso/vbits/code/mee/vbdao/visdata/indexadd.frm

Visual Basic Form | 1994-10-06 | 6.5 KB | 240 lines

VERSION 2.00
Begin Form fIndexAdd
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Add Index"
   ClientHeight    =   2775
   ClientLeft      =   3855
   ClientTop       =   3795
   ClientWidth     =   4905
   ControlBox      =   0   'False
   ForeColor       =   &H00C0C0C0&
   Height          =   3180
   Left            =   3795
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2760
   ScaleMode       =   0  'User
   ScaleWidth      =   4932
   Top             =   3450
   Width           =   5025
   Begin CheckBox cPrimaryFlag
      BackColor       =   &H00C0C0C0&
      Caption         =   "Primary"
      Height          =   252
      Left            =   3570
      TabIndex        =   9
      Tag             =   "OLR"
      Top             =   105
      Value           =   1  'Checked
      Width           =   1092
   End
   Begin TextBox cIndexName
      BackColor       =   &H00FFFFFF&
      Height          =   288
      Left            =   960
      TabIndex        =   0
      Tag             =   "OLS"
      Top             =   120
      Width           =   2532
   End
   Begin TextBox cFieldNames
      BackColor       =   &H00FFFFFF&
      Height          =   528
      Left            =   960
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   1
      Tag             =   "OLS"
      Top             =   480
      Width           =   2532
   End
   Begin ListBox cFieldList
      BackColor       =   &H00FFFFFF&
      Height          =   1590
      Left            =   960
      Sorted          =   -1  'True
      TabIndex        =   7
      Tag             =   "OLS"
      Top             =   1080
      Width           =   2535
   End
   Begin CheckBox cUniqueFlag
      BackColor       =   &H00C0C0C0&
      Caption         =   "Unique"
      Height          =   252
      Left            =   3570
      TabIndex        =   8
      Tag             =   "OLR"
      Top             =   525
      Value           =   1  'Checked
      Width           =   1092
   End
   Begin CommandButton OkayButton
      BackColor       =   &H00C0C0C0&
      Caption         =   "&OK"
      Default         =   -1  'True
      Enabled         =   0   'False
      Height          =   372
      Left            =   3600
      TabIndex        =   4
      Top             =   1320
      Width           =   1212
   End
   Begin CommandButton CloseButton
      BackColor       =   &H00C0C0C0&
      Cancel          =   -1  'True
      Caption         =   "&Close"
      Height          =   372
      Left            =   3600
      TabIndex        =   5
      Top             =   1920
      Width           =   1212
   End
   Begin Label FieldListLabel
      BackColor       =   &H00C0C0C0&
      Caption         =   "Fields:"
      Height          =   252
      Left            =   120
      TabIndex        =   6
      Top             =   1080
      Width           =   732
   End
   Begin Label FieldsLabel
      BackColor       =   &H00C0C0C0&
      Caption         =   "Indexed Fields:"
      Height          =   492
      Left            =   120
      TabIndex        =   3
      Top             =   480
      Width           =   732
   End
   Begin Label NameLabel
      BackColor       =   &H00C0C0C0&
      Caption         =   "Name:"
      Height          =   252
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   732
   End
Option Explicit
Sub cFieldList_Click ()
  Dim s As String
  s = cFieldNames
  If Len(s) = 0 Then
    cFieldNames = s + cFieldList
  Else
    cFieldNames = s & ";" & cFieldList
  End If
  cFieldNames.Refresh
End Sub
Sub cFieldNames_Change ()
  If Len(cIndexName) > 0 And Len(cFieldNames) > 0 Then
    OkayButton.Enabled = True
  Else
    OkayButton.Enabled = False
  End If
End Sub
Sub cFieldNames_LostFocus ()
  If Len(cIndexName) > 0 And Len(cFieldNames) > 0 Then
    OkayButton.Enabled = True
  Else
    OkayButton.Enabled = False
  End If
End Sub
Sub cIndexName_LostFocus ()
  If Len(cIndexName) > 0 And Len(cFieldNames) > 0 Then
    OkayButton.Enabled = True
  Else
    OkayButton.Enabled = False
  End If
End Sub
Sub CloseButton_Click ()
  Unload Me
End Sub
Sub Form_Load ()
  Dim t As TableDef
  Dim i As Integer
  If gfAddTableFlag = True Then
    caption = caption & " to " & fTblStru.cTableName
    fTblStru.cFields.Col = 0
    For i = 1 To fTblStru.cFields.Rows - 1
      fTblStru.cFields.Row = i
      cFieldList.AddItem fTblStru.cFields
    Next
  Else
    caption = caption & " to " & fTables.cTableList
    Set t = gCurrentDB.TableDefs(fTables.cTableList)
    For i = 0 To t.Fields.Count - 1
      cFieldList.AddItem t.Fields(i).Name
    Next
  End If
End Sub
Sub Form_Paint ()
  Outlines Me
End Sub
Sub IndexName_Change ()
  If Len(cIndexName) > 0 And Len(cFieldNames) > 0 Then
    OkayButton.Enabled = True
  Else
    OkayButton.Enabled = False
  End If
End Sub
Sub OkayButton_Click ()
  Dim i As New Index
  Dim t As TableDef
  Dim s As String
  On Error GoTo AddIndexErr
  SetHourglass Me
  i.Name = cIndexName
  i.Fields = cFieldNames
  i.Unique = cUniqueFlag
  If gstDataType <> SQLDB Then i.Primary = cPrimaryFlag
  If gfAddTableFlag = False Then
    Set t = gCurrentDB.TableDefs(fTables.cTableList)
    t.Indexes.Append i
  End If
  fTblStru.cIndexes.Row = 1
  fTblStru.cIndexes.Col = 0
  If Len(fTblStru.cIndexes) > 0 Then
    'add a row if the first one isn't blank
    fTblStru.cIndexes.Rows = fTblStru.cIndexes.Rows + 1
  End If
  fTblStru.cIndexes.Row = fTblStru.cIndexes.Rows - 1
  fTblStru.cIndexes.Col = 0
  fTblStru.cIndexes = cIndexName
  fTblStru.cIndexes.Col = 1
  fTblStru.cIndexes = cFieldNames
  fTblStru.cIndexes.Col = 2
  If i.Unique = False Then
    s = "False"
  Else
    s = "True"
  End If
  fTblStru.cIndexes = s
  fTblStru.cIndexes.Col = 3
  If gstDataType = SQLDB Then
    s = "N/A"
  Else
    If i.Primary = False Then
      s = "False"
    Else
      s = "True"
    End If
  End If
  fTblStru.cIndexes = s
  'reset the field for another
  cIndexName = NULL_STR
  cIndexName.SetFocus
  cFieldNames = NULL_STR
  cUniqueFlag = 1
  GoTo AddIndexEnd
AddIndexErr:
  ShowError
  Resume AddIndexEnd
AddIndexEnd:
  ResetMouse Me
End Sub